home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
Cream of the Crop 1
/
Cream of the Crop 1.iso
/
PROGRAM
/
ZSIM12.ARJ
/
EMUMENU.MOD
< prev
next >
Wrap
Text File
|
1992-01-12
|
17KB
|
683 lines
(* Modula 2 Unterprogramme fuer den CP/M Emulator
Fitted Modula2 2.0
(C) 1990 by Jürgen Weber
*)
(* $A-,$S-,$R-,$T- *)
IMPLEMENTATION MODULE EmuMenu;
FROM SYSTEM IMPORT ASSEMBLER,BYTE,WORD,ADR;
(*
TYPE PhysDiskPars = RECORD
cpm_drive : BYTE;
first_phys_sec : BYTE;
phys_tracks : BYTE;
phys_sec_pt : BYTE;
bytes_per_sec : BYTE;
autologin_flag : BYTE;
END;
dpb = RECORD
spt : WORD;
bsh : BYTE;
blm : BYTE;
exm : BYTE;
dsm : WORD;
drm : WORD;
al0 : BYTE;
al1 : BYTE;
cks : WORD;
off : WORD;
END;
DPBPtr = POINTER TO dpb;
PDPPtr = POINTER TO PhysDiskPars;
*)
CONST
TOUPPER=ORD('a')-ORD('A');
SEPERATOR='|';
BACKSLASH='\';
SCR_NORMAL=7H;
SCR_INVERS=70H;
SCR_HIGHLIT=7H+8H;
CSR_RIGHT = 115C;
CSR_LEFT = 113C;
PAGE_UP = 111C;
PAGE_DOWN = 121C;
CSR_DOWN = 120C;
CSR_UP = 110C;
HOME = 107C;
C_END = 117C;
INSERT = 122C;
ENTER = 015C;
ESC = 033C;
BS = 010C;
DEL = 177C;
CR = 015C;
LF = 012C;
PROCEDURE Read(VAR c,cx:CHAR);
(* c:=char, cx:=extended *)
BEGIN
ASM
MOV AH,0
INT 16H
LES DI,c
MOV BYTE ES:[DI],AL
LES DI,cx
MOV BYTE ES:[DI],AH
END;
END Read;
PROCEDURE ScrRead(VAR c,Attrib:CHAR);
(* c:=Zeichen an Cursorpos *)
BEGIN
ASM
MOV AH,8
MOV BL,0
INT 10H
LES DI,c
MOV BYTE ES:[DI],AL
LES DI,Attrib
MOV BYTE ES:[DI],AH
END;
END ScrRead;
PROCEDURE Write(c:CHAR);
BEGIN
IF c>037C THEN (* bei druckbaren Zeichen auch Attribute *)
ASM
MOV AX,c
MOV BX,attribute
MOV BH,0
MOV AH,9
MOV CX,1
INT 10H
END;
END;
ASM
MOV AX,c
MOV BX,attribute
MOV AH,0EH
INT 10H
END;
END Write;
PROCEDURE WriteString(s:ARRAY OF CHAR);
VAR i:CARDINAL;
BEGIN
i:=0;
(* ACHTUNG: Zuerst muss auf <=HIGH getestet werden *)
WHILE (i<=HIGH(s)) AND (s[i]<>0C) DO
Write(s[i]);
INC(i);
END;
END WriteString;
PROCEDURE ReadString(VAR s:ARRAY OF CHAR);
VAR c,cx:CHAR;
i,x,y:CARDINAL;
BEGIN
attribute:=SCR_NORMAL;
i:=0;
LOOP
Read(c,cx);
c:=Upper(c);
IF ((c=DEL) OR (c=BS)) AND (i>0) THEN
DEC(i);
WhereXY(x,y);
DEC(x);
GotoXY(x,y);
Write(' ');
GotoXY(x,y);
ELSIF (((c>=' ') AND (c<='~')) AND (i<=HIGH(s))) THEN
Write(c);
s[i]:=c;
INC(i);
ELSIF (c=CR) THEN
s[i]:=0C;
done:=TRUE;
EXIT;
ELSIF (c=ESC) THEN
i:=0;
done:=FALSE;
EXIT;
END;
END;
END ReadString;
PROCEDURE WriteLn;
BEGIN
Write(CR);
Write(LF);
END WriteLn;
PROCEDURE GotoXY(x,y:CARDINAL);
BEGIN
ASM
MOV DX,x
MOV AX,y
MOV DH,AL
MOV BH,0
MOV AH,2
INT 10H
END;
END GotoXY;
PROCEDURE WhereXY(VAR x,y:CARDINAL);
BEGIN
ASM
MOV BH,0
MOV AH,3
INT 10H
LES DI,x
MOV BYTE ES:[DI],DL
LES DI,y
MOV BYTE ES:[DI],DH
END;
END WhereXY;
PROCEDURE Upper(c:CHAR):CHAR;
BEGIN
IF (c>='a') AND (c<='z') THEN
RETURN CHR(ORD(c)-TOUPPER);
ELSE
RETURN c;
END;
END Upper;
(*
PROCEDURE ReadCard(VAR n:CARDINAL);
CONST HIGHNUM=5;
VAR s:ARRAY[0..HIGHNUM] OF CHAR;
c,cx:CHAR;
z,i,j,x,y:CARDINAL;
BEGIN
attribute:=SCR_NORMAL;
i:=0;
LOOP
Read(c,cx);
IF ((c=DEL) OR (c=BS)) AND (i>0) THEN
DEC(i);
WhereXY(x,y);
DEC(x);
GotoXY(x,y);
Write(' ');
GotoXY(x,y);
ELSIF ((c>='0') AND (c<='9')) AND (i<HIGHNUM) THEN
Write(c);
s[i]:=c;
INC(i);
ELSIF (c=CR) THEN
s[i]:=0C;
EXIT;
ELSIF (c=ESC) THEN
i:=0;
EXIT;
END;
END;
IF (i>0) THEN (* es wurde was eingegeben *)
DEC(i);
z:=0;
FOR j:=0 TO i DO
z:=z*10;
INC(z,ORD(s[j])-ORD('0'));
END;
n:=z;
END;
END ReadCard;
*)
PROCEDURE ReadHex(VAR n:WORD;d:CARDINAL);
VAR s:ARRAY[0..4] OF CHAR;
c,cx:CHAR;
z,i,j,x,y:CARDINAL;
BEGIN
attribute:=SCR_NORMAL;
i:=0;
done:=TRUE;
LOOP
Read(c,cx);
c:=Upper(c);
IF ((c=DEL) OR (c=BS)) AND (i>0) THEN
DEC(i);
WhereXY(x,y);
DEC(x);
GotoXY(x,y);
Write(' ');
GotoXY(x,y);
ELSIF (((c>='0') AND (c<='9')) OR ((c>='A') AND (c<='F')))
AND (i<d) THEN
Write(c);
s[i]:=c;
INC(i);
ELSIF (c=CR) THEN
s[i]:=0C;
EXIT;
ELSIF (c=ESC) THEN
i:=0;
done:=FALSE;
EXIT;
END;
END;
IF (i>0) THEN (* es wurde was eingegeben *)
DEC(i);
z:=0;
FOR j:=0 TO i DO
z:=z*16;
IF s[j]<'A' THEN
INC(z,ORD(s[j])-ORD('0'));
ELSE
INC(z,ORD(s[j])-ORD('A')+10);
END;
END;
n:=WORD(z);
END;
END ReadHex;
PROCEDURE ReadHexByte(VAR b:BYTE);
VAR w:WORD;
BEGIN
w:=WORD(ORD(b));
ReadHex(w,2);
b:=BYTE(CHR(CARDINAL(w)));
END ReadHexByte;
PROCEDURE WriteHexByte(b:BYTE);
VAR n:CARDINAL;
PROCEDURE WriteHexNib(w:WORD);
VAR n:CARDINAL;
BEGIN (* WriteHexNib *)
n:=CARDINAL(w);
IF n>9 THEN
Write(CHR(n-10+ORD('A')));
ELSE
Write(CHR(n+ORD('0')));
END;
END WriteHexNib;
BEGIN (* WriteHexByte *)
n:=ORD(b);
WriteHexNib(n DIV 16);
WriteHexNib(n MOD 16);
END WriteHexByte;
PROCEDURE WriteHex(w:WORD);
VAR n:CARDINAL;
BEGIN (* WriteHex *)
n:=CARDINAL(w);
WriteHexByte(CHR(n DIV 256));
WriteHexByte(CHR(n MOD 256));
END WriteHex;
(* Alten Bildschirminhalt merken *)
(* Width,Height=Breite,Hoehe *)
(* KEINE Plausibilitaetstests*)
PROCEDURE SaveWin(x,y,Width,Height:CARDINAL;VAR WinSave:ARRAY OF CHAR);
VAR WinStorPtr,x0,y0:CARDINAL;
BEGIN
WinStorPtr:=0;
FOR y0:=0 TO Height-1 DO
FOR x0:=0 TO Width-1 DO
GotoXY(x+x0,y+y0);
ScrRead(WinSave[WinStorPtr],WinSave[WinStorPtr+1]);
INC(WinStorPtr,2);
END;
END;
END SaveWin;
(* Alten Bildschirminhalt wiederherstellen *)
(* Width,Height=Breite,Hoehe *)
(* KEINE Plausibilitaetstests*)
PROCEDURE RestorWin(x,y,Width,Height:CARDINAL;VAR WinSave:ARRAY OF CHAR);
VAR WinStorPtr,x0,y0:CARDINAL;
BEGIN
WinStorPtr:=0;
FOR y0:=0 TO Height-1 DO
FOR x0:=0 TO Width-1 DO
GotoXY(x+x0,y+y0);
attribute:=ORD(WinSave[WinStorPtr+1]);
Write(WinSave[WinStorPtr]);
INC(WinStorPtr,2);
END;
END;
END RestorWin;
(* Width,Height=Breite,Hoehe *)
(* KEINE Plausibilitaetstests*)
PROCEDURE DrawBox(x,y,Width,Height:CARDINAL);
VAR x0,y0:CARDINAL;
BEGIN
GotoXY(x,y);
Write('┌');
FOR x0:=1 TO Width-2 DO
Write('─');
END;
Write('┐');
FOR y0:=1 TO Height-2 DO
GotoXY(x,y+y0);Write('│');
FOR x0:=1 TO Width-2 DO
Write(' ');
END;
Write('│');
END;
GotoXY(x,y+Height-1);
Write('└');
FOR x0:=1 TO Width-2 DO
Write('─');
END;
Write('┘');
END DrawBox;
PROCEDURE DoMenue(x,y:CARDINAL;messages:ARRAY OF CHAR;
VAR WinSave:ARRAY OF CHAR;VAR res:CARDINAL);
CONST MAXMSG=19;
VAR p,i,LenCount,MsgCount,
oldX,oldY,
MaxItemLen,item:CARDINAL;
MsgStart:ARRAY [0..MAXMSG] OF CARDINAL;
frstLet:ARRAY [0..MAXMSG] OF CHAR;
c,cx:CHAR;
ExtendedChar:BOOLEAN;
PROCEDURE DisplayItem(p:CARDINAL); (* z.B. \edit|e\xit| *)
VAR x0:CARDINAL;
BEGIN
p:=MsgStart[p-1];
x0:=0;
WHILE (messages[p]<>SEPERATOR) DO
IF (attribute=SCR_NORMAL) THEN
IF (messages[p]=BACKSLASH) THEN
(* Schreibe das helle Zeichen *)
INC(p);
attribute:=SCR_HIGHLIT;
Write(messages[p]);
attribute:=SCR_NORMAL;
ELSE
Write(messages[p]);
END;
ELSE (* im gerade gewaehlten Bereich *)
IF (messages[p]=BACKSLASH) THEN
INC(p);
END;
Write(messages[p]);
END;
INC(p);INC(x0);
END;
WHILE (x0<MaxItemLen) DO
Write(' ');
INC(x0);
END;
END DisplayItem;
BEGIN
(* erstmal Anzahl und laengste Message finden *)
p:=0;MaxItemLen:=0;MsgCount:=0;
WHILE (messages[p]<>0C) DO
LenCount:=0;
MsgStart[MsgCount]:=p;
WHILE (messages[p]<>SEPERATOR) DO
IF (messages[p]=BACKSLASH) THEN
INC(p);
frstLet[MsgCount]:=messages[p];
END;
INC(p);INC(LenCount);
END;
INC(p);
IF LenCount>MaxItemLen THEN MaxItemLen:=LenCount;END;
INC(MsgCount);
END;
(* Alten Cursorpos und Bildschirminhalt merken *)
WhereXY(oldX,oldY);
SaveWin(x,y,MaxItemLen+2,MsgCount+2,WinSave);
(* Rahmen und Menuepunkte schreiben *)
attribute:=SCR_NORMAL;
DrawBox(x,y,MaxItemLen+2,MsgCount+2);
FOR item:=1 TO MsgCount DO
GotoXY(x+1,y+item);
DisplayItem(item);
END;
(* aktuelles Element invers darstellen, Zeichen lesen
und Element wieder normal darstellen *)
item:=1;
LOOP
attribute:=SCR_INVERS;
GotoXY(x+1,y+item);
DisplayItem(item);
attribute:=SCR_NORMAL;
Read(c,cx);
IF (c=0C) THEN c:=cx;ExtendedChar:=TRUE ELSE ExtendedChar:=FALSE END;
GotoXY(x+1,y+item);
DisplayItem(item);
IF c=ESC THEN
item:=0;
EXIT;
ELSIF c=ENTER THEN
EXIT;
END;
IF ExtendedChar THEN
CASE c OF
HOME : item:=1
| C_END : item:=MsgCount
| CSR_UP : IF item>1 THEN DEC(item) ELSE item:=MsgCount END
| CSR_DOWN : IF item<MsgCount THEN INC(item) ELSE item:=1 END
END;
ELSE
(* um zufaellige Uebereinstimmung von Extended
und highlight Char auszuschliessen *)
FOR i:=0 TO MsgCount DO
IF (Upper(c)=Upper(frstLet[i])) THEN
item:=i+1; (* Da Anfang bei 0 *)
EXIT;
END;
END;
END;
END;
res:=item;
(* Alten Bildschirminhalt und Cursorpos wiederherstellen *)
RestorWin(x,y,MaxItemLen+2,MsgCount+2,WinSave);
GotoXY(oldX,oldY);
END DoMenue;
PROCEDURE Tab(t:CARDINAL);
VAR x0,y0:CARDINAL;
BEGIN
WhereXY(x0,y0);
GotoXY(t,y0);
END Tab;
PROCEDURE EditDPB(p:DPBPtr;q:PDPPtr;
VAR WinSave:ARRAY OF CHAR;VAR OK:BOOLEAN);
CONST XCORN=5;
YCORN=5;
RDX=12;
LENX=20;
LENY=19;
VAR oldX,oldY:CARDINAL;
BEGIN
(* Alten Cursorpos und Bildschirminhalt merken *)
WhereXY(oldX,oldY);
attribute:=SCR_NORMAL;
SaveWin(XCORN,YCORN,LENX,LENY,WinSave);
DrawBox(XCORN,YCORN,LENX,LENY);
GotoXY(XCORN+1,YCORN+1);WriteString('SPT: ');WriteHex (p^.spt);
GotoXY(XCORN+1,YCORN+2);WriteString('BSH: ');WriteHexByte(p^.bsh);
GotoXY(XCORN+1,YCORN+3);WriteString('BLM: ');WriteHexByte(p^.blm);
GotoXY(XCORN+1,YCORN+4);WriteString('EXM: ');WriteHexByte(p^.exm);
GotoXY(XCORN+1,YCORN+5);WriteString('DSM: ');WriteHex (p^.dsm);
GotoXY(XCORN+1,YCORN+6);WriteString('DRM: ');WriteHex (p^.drm);
GotoXY(XCORN+1,YCORN+7);WriteString('AL0: ');WriteHexByte(p^.al0);
GotoXY(XCORN+1,YCORN+8);WriteString('AL1: ');WriteHexByte(p^.al1);
GotoXY(XCORN+1,YCORN+9);WriteString('CKS: ');WriteHex (p^.cks);
GotoXY(XCORN+1,YCORN+10);WriteString('OFF :');WriteHex (p^.off);
GotoXY(XCORN+1,YCORN+12);WriteString('DRV: ');
WriteHexByte(q^.cpm_drive);
GotoXY(XCORN+1,YCORN+13);WriteString('PTR: ');
WriteHexByte(q^.phys_tracks);
GotoXY(XCORN+1,YCORN+14);WriteString('PST: ');
WriteHexByte(q^.phys_sec_pt);
GotoXY(XCORN+1,YCORN+15);WriteString('BPS: ');
WriteHexByte(q^.bytes_per_sec);
GotoXY(XCORN+1,YCORN+16);WriteString('FSC: ');
WriteHexByte(q^.first_phys_sec);
GotoXY(XCORN+1,YCORN+17);WriteString('LOG: ');
WriteHexByte(q^.autologin_flag);
LOOP
OK:=FALSE;
GotoXY(XCORN+RDX,YCORN+1); WriteString(': ');ReadHex (p^.spt,4);
IF NOT done THEN
EXIT;
END;
GotoXY(XCORN+RDX,YCORN+2); WriteString(': ');ReadHexByte(p^.bsh);
IF NOT done THEN
EXIT;
END;
GotoXY(XCORN+RDX,YCORN+3); WriteString(': ');ReadHexByte(p^.blm);
IF NOT done THEN
EXIT;
END;
GotoXY(XCORN+RDX,YCORN+4); WriteString(': ');ReadHexByte(p^.exm);
IF NOT done THEN
EXIT;
END;
GotoXY(XCORN+RDX,YCORN+5); WriteString(': ');ReadHex (p^.dsm,4);
IF NOT done THEN
EXIT;
END;
GotoXY(XCORN+RDX,YCORN+6); WriteString(': ');ReadHex (p^.drm,4);
IF NOT done THEN
EXIT;
END;
GotoXY(XCORN+RDX,YCORN+7); WriteString(': ');ReadHexByte(p^.al0);
IF NOT done THEN
EXIT;
END;
GotoXY(XCORN+RDX,YCORN+8); WriteString(': ');ReadHexByte(p^.al1);
IF NOT done THEN
EXIT;
END;
GotoXY(XCORN+RDX,YCORN+9); WriteString(': ');ReadHex (p^.cks,4);
IF NOT done THEN
EXIT;
END;
GotoXY(XCORN+RDX,YCORN+10);WriteString(': ');ReadHex (p^.off,4);
IF NOT done THEN
EXIT;
END;
GotoXY(XCORN+RDX,YCORN+12);WriteString(': ');ReadHexByte(q^.cpm_drive);
IF NOT done THEN
EXIT;
END;
IF ORD(q^.cpm_drive)>1 THEN
q^.cpm_drive:=BYTE(CHR(0)); (* nur Disklaufwerke zulaessig *)
END;
GotoXY(XCORN+RDX,YCORN+13);WriteString(': ');ReadHexByte(q^.phys_tracks);
IF NOT done THEN
EXIT;
END;
GotoXY(XCORN+RDX,YCORN+14);WriteString(': ');ReadHexByte(q^.phys_sec_pt);
IF NOT done THEN
EXIT;
END;
GotoXY(XCORN+RDX,YCORN+15);WriteString(': ');ReadHexByte(q^.bytes_per_sec);
IF NOT done THEN
EXIT;
END;
GotoXY(XCORN+RDX,YCORN+16);WriteString(': ');ReadHexByte(q^.first_phys_sec);
IF NOT done THEN
EXIT;
END;
GotoXY(XCORN+RDX,YCORN+17);WriteString(': ');ReadHexByte(q^.autologin_flag);
OK:=done; (* nur TRUE, wenn auch letztes Lesen o.k. war *)
EXIT;
END;
RestorWin(XCORN,YCORN,LENX,LENY,WinSave);
GotoXY(oldX,oldY);
END EditDPB;
PROCEDURE About(VAR WinSave:ARRAY OF CHAR);
CONST XCORN=30;
YCORN=8;
LENX=20;
LENY=10;
VAR oldX,oldY:CARDINAL;
c,cx:CHAR;
BEGIN
(* Alten Cursorpos und Bildschirminhalt merken *)
WhereXY(oldX,oldY);
attribute:=SCR_NORMAL;
SaveWin(XCORN,YCORN,LENX,LENY,WinSave);
DrawBox(XCORN,YCORN,LENX,LENY);
GotoXY(XCORN+7,YCORN+1);
attribute:=SCR_HIGHLIT;WriteString('ZSIM');attribute:=SCR_NORMAL;
GotoXY(XCORN+2,YCORN+3);WriteString('THE Z80 Emulator');
GotoXY(XCORN+2,YCORN+5);WriteString('(C) 1990,1991 by');
GotoXY(XCORN+2,YCORN+6);WriteString('Jürgen G. Weber');
GotoXY(XCORN+4,YCORN+8);
attribute:=SCR_HIGHLIT;WriteString('PRESS ESC');attribute:=SCR_NORMAL;
REPEAT
Read(c,cx);
UNTIL c=ESC;
RestorWin(XCORN,YCORN,LENX,LENY,WinSave);
GotoXY(oldX,oldY);
END About;
PROCEDURE InputString(VAR WinSave,s,p:ARRAY OF CHAR);
(* Es wird vorrausgesetzt, daß prompt p < 30 und string s < 30 *)
CONST XCORN=10;
YCORN=15;
LENX=40;
LENY=5;
VAR oldX,oldY:CARDINAL;
c,cx:CHAR;
BEGIN
(* Alten Cursorpos und Bildschirminhalt merken *)
WhereXY(oldX,oldY);
attribute:=SCR_NORMAL;
SaveWin(XCORN,YCORN,LENX,LENY,WinSave);
DrawBox(XCORN,YCORN,LENX,LENY);
GotoXY(XCORN+2,YCORN+2);WriteString(p);
GotoXY(XCORN+2,YCORN+3);
ReadString(s);
RestorWin(XCORN,YCORN,LENX,LENY,WinSave);
GotoXY(oldX,oldY);
END InputString;
VAR attribute:CARDINAL;
done:BOOLEAN;
BEGIN
END EmuMenu.